Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/PBLIB1/UNITS/PBMISC.PAS

Pascal/Delphi Source File | 1994-05-04 | 22KB | 575 lines

{SECTION ..PbMISC }
UNIT PbMISC;

INTERFACE

Uses  DOS;

{
Description:  Miscellaneous routines useable by most other units

              * TRY FOR NO OTHER DEPENDENCIES *

Author      : Howard Richoux
Date        : 8/1/90
Last revised: 2/17/94 MASSIVE COMBO
              2/17/94 Combined PTIMstuf and PARSstuf and made DLL compatible
              2/17/74 added MyFile and the DEF BP logic and TEXTSEEK
              4/30/94 some cleaning up
Application : IBM PC and compatibles, done using Turbo Pascal 7
Status      : Placed in the Public Domain by HNR Software 1/29/94
Published in: none
}


const fREADONLY             =  0;   { File open modes }
const fWRITEONLY            =  1;
const fREADWRITE            =  2;
const fOPENSHARE            =  64;  {1/28/94 - when share is present }
const fCREATE               = -1;

const fNoSort               = 0;
const fSortbyName           = 1;
const fSortbyExt            = 2;

const tenthousand : longint = 10000;
const onehundred  : longint = 100;



type  termchars             =  set of char;

type  PTime                 =  Longint;         { type defined here, used in DOS as longint}
type  Julian                =  real;            {~DateStuf }

type  DateRec =  record           {~DateStuf }
             month, day, year : integer;
             end;


var  quotechar         : char;     { typically single or double quotes }
     commenteolchar    : char;     { typically exclamation point }
     commentpairLchar  : char;     { typically left squiggley bracket }
     commentpairRchar  : char;     { typically right squiggley bracket }
     qstringtoken      : char;     { char to use for tokenizing a string }
var  multilinecomment  : boolean;  { true while mismatched comment brackets}



TYPE  FSCAN_ProcType        = Procedure (VAR S : SearchRec; P : PathStr);
TYPE  FSCAN_FullNameStr     = STRING[12];
TYPE  FSCAN_ProcessLineProc = procedure(s : string);




Function  AddBackSlash(s1 : string) : string;
                        {[FILE] puts '\' on if needed}

Function  BooleanStr( B : boolean ) : string;
                        {[STRING] formats boolean  "YES"/"NO"}

Function  BreakLineChr(var s : string; bklen : integer; ch : char) : string;
                        {[STRING] splits string at nearest "ch" back}

Function  BreakLine(var s : string; bklen : integer) : string;
                        {[STRING] splits string at nearest blank or comma back}

Function  ByteToHex( B : byte) : string;
                        {[STRING] 1 byte conversion to hex  00-FF}

Function  Buf16ToHexStr(addr : longint; count : integer; var xbuf; flag : boolean) : string;
                        {[STRING] One line of the DUMP output ( 1 <= count <= 16}

Function  CenterStr(s : string; w : byte) : string;
                        {[STRING] TUGstuf}

Procedure CleanUpBlanks(var s : string);
                        {[STRING] Gets rid of excess blanks}

Procedure CleanUpComments(var s : string);
                        {[STRING] Removes bracketed comments}

Procedure CleanUpString(var s : string);
                        {[STRING] Gets rid of bracketed comments and excess blanks }

Function  Compare(s1,s2 :string) : boolean;
                        {[STRING] Compares s1 to s2 - s2 can have wildcards }

Function  CompareL(s1,s2 :string; len : integer) : boolean;
                        {[STRING] Compares s1 to s2 for length len }

Function  CompareUpL(s1,s2 :string; len : integer) : boolean;
                        {[STRING] Compares s1 to s2 for length len (s1,s2 shifted UP)}

Function  CompressStr(s1 : string) : string;
                        {[STRING] simple minded compression}

Function  ConstStr(C : Char; N : Integer) : string;
                        {[STRING] Construct string of chars }

Function  CopyRemove(var s : string; f,l : integer) : string;
                        {[STRING] copies then deletes a substring }

Function  CurrDTimeString : string;
                        {[DATETIME] current as mm/dd/yy hh:mm:ss}

Function  DateToJulian(Date : DateRec) : REAL;
                        {[DATETIME] YMD DateRec -> real }

Function  DaysBetweenDBaseDates(dt1,dt2 : string) : integer;
                        {[DATETIME] difference in days between DBase dates}

Function  DaysBetweenPTimes(PT1, PT2 : PTime) : longint;
                        {[DATETIME] difference in days between PTs}

Function  DaysInMonth(month, year : integer) : byte;
                        {[DATETIME] How many days in given month. }

Function  DBaseToPTime(s : string) : PTIME;
                        {[DATETIME] 'yyyymmdd' -> PT (longint) }

Function  DefaultDriveStr : string;
                        {[FILE] returns current drive}

Function  DeleteBackSlash(s1 : string) : string;
                        {[FILE] gets rid of '\'}

Function  DeQuoteString(s : string) : string;
                        {[STRING] Removes end quoted - see also QT and UnQT}

Procedure DeTokenizeStrings(var s,hold : string);
                        {[STRING] Puts back the strings}

Function  DirTag(path : string) : string;
                        {[FILE] the 8 char name for the DIR.}

Function  DnCaseStr(s : string) : string;
                        {[STRING] makes STRING -> string }

Function  DollarStr( R : real; L : integer ) : string;
                        {[STRING] formats $ values}

Function  DOSErrStr(err : integer) : string;
                        {[FILE] returns some text about err}

Procedure DumpRecBufInHex(recnum : longint; recsiz : integer; var rec);
                        {[DEBUG] Dumps a record buffer in HEX }

Function  EquivalentFile(fn1,fn2 : string) : boolean;
                        {[FILE] same eof/time diff name}

Procedure EraseFile(s : string);
                        {[FILE] no return, just does it if possible}

Function  ExtractDelimitedStr(var s : string; lchar,rchar : char) : string;
                        {[STRING] extracts a delimited substring }

Function  ExtractPath(var fname : string) : string;
                        {[FILE] returns all but name & ext}

Function  FileDate(fname : string; ext : string) : longint;
                        {[FILE] returns last mod date}

Function  FileExists(FName : String) : boolean;
                        {[FILE] returns true if file exists}

Function  FileExt(fname : string) : string;
                        {[FILE] returns just the file extenstion}

Function  FileInfo(filespec : string; ext : string;var SR : searchrec) : integer;
                        {[FILE] first file that matches}

Function  FileExtStr(fname : string) : string;
                        {[FILE] returns just the file extension (no path or name)}

Function  FilePathStr(fname : string) : string;
                        {[FILE] returns just the file directory (no name or ext)}

Function  FileRootStr(fname : string) : string;
                        {[FILE] returns just the file name root (no path or ext)}

Function  FindAndReplaceStr(str,fstr,rstr : string; both,all : boolean) : string;
                        {[STRING] finds fstr replaces with rstr, options}

Function  FmtAddress( a : longint; l : integer; flag : boolean) : string;
                        {[STRING] formats a longint optionally as hex - for DUMP }

Function  FmtCvtChr(b : byte) : string;
                        {[STRING] actual conversion, lowest level}

Function  FmtChr(b : byte) : string;
                        {[STRING] converts invisible chars to strings }

Function  FmtStr(s : string) : string;
                        {[STRING] DATACOM debugging tool, #27 -> <Esc> ...}

Function  FmtHMS(hr, mn, sc : word) : string;
                        {[DATETIME]  --> "hh:mm:ss"}

Function  FmtKstr(l : longint) : string;
                        {[STRING] nnnnnk for file bytes}

Function  FmtKstrComma(l : longint) : string;
                        {[STRING] nn,nnnk for file bytes}

Function  FmtPDateStr(PT : PTime) : string;
                           {[DATETIME] Returns 'mm/dd/yy' from PT }

Function  FmtPTimeStr(PT : PTime) : string;
                           {[DATETIME] Returns 'mm/dd/yy hh:mm:ss' from PT }

Function  FmtYMD(Yr, Mo, Da : word) : string;
                        {[DATETIME]  --> "mm/dd/yy"}

Procedure ForceExt(var fname : string; ext : string);
                        {[FILE] make sure .ext is what you want}

Function  ForceRenameToBAK(fname : string) : boolean;
                        {[FILE] Erases .BAK file first. }

Procedure ForcePath(var fname : string; path : string);
                        {[FILE] substitutes path for whatever fname has.}

Function  ForceRenameFile(fname1,fname2 : string) : boolean;
                        {[FILE] Erases file 2 first. }

Function  FormatDTime : string;
                        {[DATETIME] current as mm/dd/yy hh:mm:ss}

Function  GETAlphaStr ( var s : string) : string;
                        {[STRING] a..z,A..Z - trims off leading non-alphas}

Function  GETAlphaNumericStr( var s : string) : string;
                        {[STRING] a..z,A..Z,0..9 - trims off leading non-A/Ns}

Function  GETBoolean (var s : string) : boolean;
                        {[STRING] Returns false on "NO" and "OFF", true otherwise}

Function  GetCurrPTime(var pt : PTime) : word;
                        {[DATETIME] Gets Current date/time as PT, func ret is D.O.W.}

Function  GETDelimitedStr ( var s : string; lchr,rchr : char) : string;
                        {[STRING] Removes string in paired brackets, l & r CAN be same}

Function  GETInteger (var s : string) : integer;
                        {[STRING] Deletes until numerics and returns number}

Function  GETLeftStr ( var s : string; tch : char) : string;
                        {[STRING] Removes left string up to "tch" }

Function  GETLongInt (var s : string) : longint;
                        {[STRING] Deletes until numerics and returns number}

Function  GETNumericStr ( var s : string) : string;
                        {[STRING] 0..9+-. - trims off leading non-numerics}

Function  GETReal (var s : string) : real;
                        {[STRING] Deletes until numerics and returns number}

Function  GETRightStr ( var s : string; tch : char) : string;
                        {[STRING] Removes right string down to "tch" }

Function  GetString ( var s : string) : string;
                        {[STRING] gets sub-string to next comma}

Function  GetNumber( var astring : string) : real;
                        {[STRING] gets string to next comma, as number}

Function  HexToByte( st : string) : byte;
                        {[STRING] 1 byte conversion from hex}

Function  HexToLongInt(s : string) : longint;
                        {[STRING] xxxx to longint}

Function  HexAddressToLongInt(s : string) : longint;
                        {[STRING] xxxx:yyyy to longint}

Function  IntegerStr( I : integer; L : integer ) : string;
                        {[STRING] formats integer}

Function  Int2Real(i : Integer) : real;
                        {[MISC] ??}

Procedure JulianToDate(Julian : REAL; var Date : DateRec);
                        {[DATETIME] real -> YMD DateRec }

Function  JulianToPTime(J : Julian) : PTime;
                        {[DATETIME] real -> PT (longint) }


Function  LeftStr( St : string; L : integer ) : string;
                        {[STRING] copies the left L chars }

Function  LJStr(s : string; w : byte) : string;
                        {[STRING] TUGstuf produces a left justified str length w}

Function  LongIntStr( I : longint; L : integer ) : string;
                        {[STRING] formats longint}

Function  LScan(str : string; tch : char) : byte;
                        {[STRING] Finds FIRST occurance of char TCH in string STR }

Function  MergeStr( s : string; posn : integer; s1 : string) : string;
                        {[STRING] Function version of ReplaceStr}

Function  Min(i1,i2 : integer) : integer;
                        {[MISC] chooses lesser of two ints}

Procedure MiscDelayNTicks(n : longint);
                        {[DATETIME] A delay of 1 seems to be about 0.05 seconds}

Function  MonthStr(mm : integer) : string;
                        {[DATETIME] 'Jan', 'Feb' ... }

Function  NibbleString(var s : string;tch : termchars; var termch : char) : string;
                        {[STRING] Fetches to one of a SET of chars - see also GetLeftStr }

Function  NumericsOnlyStr(s : string) : string;
                        {[STRING] gets rid of non-numerics}

Function  PackTimestr(PT : longint) : string;
                        {[DATETIME] PT as mm/dd/yy hh:mm:ss}

Procedure PatchStr(var s : string; ch1,ch2 : char);
                        {[STRING] replaces all ch1's with ch2's}

Function  PctStr(x,y : real; L,D : integer) : string;
                        {[STRING] formats as a percentage x/y}

Function  ProperName(s : string) : string;
                        {[STRING] makes STRING -> String }

Function  PTDayOfTheWeek( pt : PTime ) : word;
                        {[DATETIME] Returns D.O.W. from a PT }

Function  PTimePlusDays(PT : PTime; days : integer) : PTime;
                        {[DATETIME] Add days to a PT (longint) }

Function  PTimeToDBase(pt : PTime) : string;
                        {[DATETIME] PT (longint) -> 'yyyymmdd' }

Procedure PTimeToDMY(PT : PTime; var dd,mm,yy : integer);
                        {[DATETIME] PT (longint) -> dd,mm,yy}

Function  PTimeToJulian(PT : PTime) : real;
                        {[DATETIME] PT (longint) -> real }

Function  QT(s : string) : string;
                        {[STRING] makes a string with quotes around it }

Function  RealStr( R : real; L,D : integer ) : string;
                        {[STRING] formats real}

Function  RealZero( x : real) : boolean;
                        {[MISC] checks for nearly 0}

Function  Real2Int(x : real) : Integer;
                        {[MISC] ??}

Procedure RemoveBlanks(var astring : string);
                        {[STRING] removes ALL blanks }

Function  RemoveBracketComments(var s : string; lchar,rchar : char) : boolean;
                        {[STRING] A little smarter than RemoveDelimitedString}

Procedure RemoveDelimitedString ( var s : string; lchr,rchr : char);
                        {[STRING] Uses GetDelimitedStr and throws it away}

Procedure RemoveEOLComments(var s : string; cchar : char);
                        {[STRING] Clears comments designated by char to EOL (like !)}

Procedure RemoveExcessBlanks(var astring : string);
                        {[STRING] gets rid of double blanks}

Procedure RemoveEnds(var s : string);
                        {[STRING] - Removes first and last char from string}

Function  RemoveBrackets(s : string) : string;
                        {[STRING] - Removes various delimiters ONLY if on ends}

Procedure RemoveLeading(var s : string; ch : CHAR);
                        {[STRING] TUGstuf removes leading ch's}

Procedure RemoveTrailing(var s : string; ch : CHAR);
                        {[STRING] TUGstuf removes trailing ch's}

Function  RenameFile(fname1,fname2 : string) : boolean;
                        {[FILE] Returns false if fails. }

Procedure ReplaceStr( var Str : string; Offset : integer; S1 : string);
                        {[STRING] puts s1 into s }

Function  RightStr( St : string; L : integer ) : string;
                        {[STRING] copies the right L chars }

Function  ReplaceStringWithToken(var s,s1 : string; token : char) : boolean;
                        {[STRING] Pulls out quoted string, puts in a placeholder }

Function  RJStr(s : string; w : byte) : string;
                        {[STRING] TUGstuf produces a right justified str length w}

Function  Rpos(substr,str : string) : byte;
                        {[STRING] Equivalent to POS, but returns last occurance }

Function  RScan(str : string; tch : char) : byte;
                        {[STRING] Finds LAST occurance of char TCH in string STR }

Function  SameFile(fn1,fn2 : string) : boolean;
                        {[FILE] same file diff dir }

Procedure SetDateBytes(var yr,mo,dy : byte);
                        {[DATETIME] xBase support}

Procedure ShiftUPString(var s : string);
                        {[STRING] Procedure normally use function UpCaseStr }

Function  SizeofFile(fname : string; ext : string) : longint;
                        {[FILE] returns eof}

Function  StringToPTime(s : string) : PTIME;
                        {[DATETIME] flexible date input to PT }

Function  StrInt(s : string) : integer;
                        {[MISC] trims leading non-numerics}

Function  StrReal(s : string) : real;
                        {[MISC] trims leading non-numerics}

Function  StrLong(s : string) : longint;
                        {[MISC] trims leading non-numerics}

Function  StrBool (s : string) : boolean;
                        {[MISC] ??}

Procedure StrCal(ds : string; var dd,mm,yy : integer);
                        {[DATETIME] flexible date input " 3/1", "10/5/93" ...}

Procedure SuggestExt(var fname : string; ext : string);
                        {[FILE] only if EXT not specified}

Function  TicksSinceMidnight : longint;
                        {[DATETIME] number of 1/100 seconds}

Function  TicksToSecs ( t : longint ) : real;
                        {[DATETIME] a tick is 1/100 second}

Function  TicksToSecsStr ( t : longint ) : string;
                        {[DATETIME] a tick is 1/100 second  tk -> hh:mm:ss }

Procedure TokenizeStrings(var s,hold : string);
                        {[STRING] Pulls out quoted strings to hold - use before cleaning string}

Procedure Trim(var s : string);
                        {[STRING] Procedure - removes left and right blanks}

Function  TrimStr(s : string) : string;
                        {[STRING] Function - removes left and right blanks}

Function  UnCompressStr(s : string) : string;
                        {[STRING] simple minded de-compression}

Function  UnQT(s : string) : string;
                        {[STRING] removes quotes from around a string }

Function  UpCaseStr(s : STRING) : string;
                        {[STRING] TUGstuf produces String shifted UP}

Function  VolumeLabel( drive : string) : string;
                        {[FILE] returns vol label (up to 8 chars)}



Function  MyOpenFileExisting(var fvar : file; fname : string;
                recsize, fmode : integer; var error : integer) : boolean;
                    {[FILE] standardized call}

Function  MyOpenFileCreate(var fvar : file; fname : string;
                recsize : integer; var error : integer) : boolean;
                    {[FILE] standardized call}

Function  MyBlockRead(var fvar : file; var buf; count : integer;
                var numread, error : integer) : boolean;
                    {[FILE] standardized call}

Function  MyBlockWrite(var fvar : file; var buf; count : integer;
                var numwritten,error : integer) : boolean;
                    {[FILE] standardized call}

Function  MyCloseFile(var fvar : file; var error : integer) : boolean;
                    {[FILE] standardized call}

Function  MySeek(var fvar : file; n : longint; var error : integer) : boolean;
                    {[FILE] standardized call}

Function  TextSeek(var f:text; n:longint) : boolean;
                    {[FILE] The equivelant of seek - goes to location}

Function  TextPos(var f:text):longint;
                    {[FILE] The equivelant of filepos - returns location}

Function  FmtFileInfo(fname,ext : string) : string;
             {[FILE] gets info and formats it}

Function  FmtSearchRec(SR : SearchRec) : string;
             {[FILE] Return like DIR listing }

Function  FmtSearchRecK(SR : SearchRec) : string;
             {[FILE] Return like DIR listing - kbytes }

Function  FullFmtFileInfo(fname,ext : string; p : pathstr) : string;
             {[FILE] gets info and formats it(FULL PATH)}

Function  FullFmtSearchRec(SR : SearchRec; p : pathstr) : string;
             {[FILE] Return like DIR listing, but FULL filename }

Function  FullFmtSearchRecK(SR : SearchRec; p : pathstr) : string;
             {[FILE] Return like DIR listing, but FULL filename - kBytes}

Procedure SearchEngine(Mask : PathStr; Attr : Byte; Proc : FSCAN_ProcType;
                            VAR ErrorCode : Byte);
             {[FILE] Engine for scanning file info from one directory }

Procedure SearchEngineAll(path  : PathStr; Mask : FSCAN_FullNameStr;
                      Attr : Byte; Proc : FSCAN_ProcType; VAR ErrorCode : Byte);
             {[FILE] Engine for scanning file info from ALL directories }

Function  SEGoodDirectory(S : SearchRec) : Boolean;
             {[FILE] internal for FILE SearchEngine }

Procedure SEErrorMessage(ErrCode  : Byte);
             {[FILE] internal for FILE SearchEngine }

Procedure SESearchOneDir(VAR S : SearchRec; P : PathStr);
             {[FILE] Recursive Procedure to search one directory}

Function  ExecuteCommand(cmd : string) : integer;
             {[EXEC] run DOS commands from program }

Function  TPC(fname,options : string; var err : integer) : boolean;
             {[EXEC] - Invokes the compiler directly, finds a few errors}

IMPLEMENTATION


{ reference info - record structures from DOS unit
types: type DateTime  =  record         ( from DOS unit )
             year, month, day, hour, min, sec : word;
             end;}


{$I MISCCORE.INC }   { old MiscStuf }

{$I MISCPTIM.INC }   { old PTimStuf }

{$I MISCPARS.INC }   { old ParsStuf }

{$I MISCMYFI.INC }   { old MYFile }

{$I MISCOTHR.INC }   { VARIOUS }

{section  _Initialization}
     begin {initialization}
     ScanStufInit;
     end.